Option Explicit

'* ---  FormatMessage  --- */
'FormatMessage.dwFlags
Private Const FORMAT_MESSAGE_ALLOCATE_BUFFER As Long = &H100
Private Const FORMAT_MESSAGE_ARGUMENT_ARRAY As Long = &H2000
Private Const FORMAT_MESSAGE_FROM_HMODULE As Long = &H800
Private Const FORMAT_MESSAGE_FROM_STRING As Long = &H400
Private Const FORMAT_MESSAGE_FROM_SYSTEM As Long = &H1000
Private Const FORMAT_MESSAGE_IGNORE_INSERTS As Long = &H200
Private Const FORMAT_MESSAGE_MAX_WIDTH_MASK As Long = &HFF

'FormatMessage(API)
Private Declare PtrSafe Function FormatMessage Lib "kernel32" Alias "FormatMessageA" (ByVal dwFlags As Long, lpSource As Long, _
        ByVal dwMessageId As Long, ByVal dwLanguageId As Long, _
        ByVal lpBuffer As String, ByVal nSize As Long, Arguments As LongPtr) _
        As Long

'* ---  WSAStartup / WSACleanup  --- */
'WSAStartup / WSACleanup size
Private Const WSASYS_STATUS_LEN  As Long = 128
Private Const WSASYS_STATUS_SIZE As Long = WSASYS_STATUS_LEN + 1
Private Const WSADESCRIPTION_LEN As Long = 256
Private Const WSADESCRIPTION_SIZE As Long = WSADESCRIPTION_LEN + 1

Public Type WSADATA
    wVersion As Integer
    wHighVersion As Integer
    szDescription As String * WSADESCRIPTION_SIZE
    szSystemStatus As String * WSASYS_STATUS_SIZE
    iMaxSockets As Integer
    iMaxUdpDg As Integer
    lpVendorInfo As Long
End Type

'WSAStartup / WSACleanup(API)
Public Declare PtrSafe Function WSAStartup Lib "ws2_32.dll" (ByVal wVersionRequested As Integer, ByRef lpWSADATA As WSADATA) As Long
Public Declare PtrSafe Function WSACleanup Lib "wsock32.dll" () As Long

'* ---  Network@ --- */
Private Enum AF
  AF_UNSPEC = 0
  AF_INET = 2
  AF_IPX = 6
  AF_APPLETALK = 16
  AF_NETBIOS = 17
  AF_INET6 = 23
  AF_IRDA = 26
  AF_BTH = 32
End Enum

Private Enum SOCKTYPE
   SOCK_STREAM = 1
   SOCK_DGRAM = 2
   SOCK_RAW = 3
   SOCK_RDM = 4
   SOCK_SEQPACKET = 5
End Enum

Private Enum PROTOCOL
   IPPROTO_ICMP = 1
   IPPROTO_IGMP = 2
   BTHPROTO_RFCOMM = 3
   IPPROTO_TCP = 6
   IPPROTO_UDP = 17
   IPPROTO_ICMPV6 = 58
   IPPROTO_RM = 113
End Enum

' IPv4 address
Public Type sockaddr_in
    sin_family As Integer
    sin_port As Integer
    sin_addr As Long
    sin_zero1 As Long
    sin_zero2 As Long
End Type

Private Const INVALID_SOCKET = -1
Private Const SOCKET_ERROR As Long = -1

'socket / closesocket(API)
Public Declare PtrSafe Function socket Lib "wsock32.dll" (ByVal lngAf As LongPtr, ByVal lngType As LongPtr, ByVal lngProtocol As LongPtr) As Long
Public Declare PtrSafe Function closesocket Lib "ws2_32.dll" (ByVal socketHandle As Long) As Long
'bind(API)
Private Declare PtrSafe Function bind Lib "ws2_32.dll" (ByVal s As Long, ByRef name As sockaddr_in, ByVal namelen As Long) As Long
'accept(API)
Private Declare PtrSafe Function accept Lib "ws2_32.dll" (ByVal s As Long, ByRef name As sockaddr_in, ByRef namelen As LongPtr) As Long
'htons(API)
Private Declare PtrSafe Function htons Lib "ws2_32.dll" (ByVal hostshort As Long) As Integer
'ntohs(API)
Private Declare PtrSafe Function ntohs Lib "ws2_32.dll" (ByVal netshort As Long) As Integer
'inet_addr(API)
Private Declare PtrSafe Function inet_addr Lib "ws2_32.dll" (ByVal cp As String) As Long

Private Declare PtrSafe Function InetNtopW Lib "ws2_32.dll" (ByVal Family As Integer, ByRef pAddr As Long, ByVal pStringBuf As String, ByVal StringBufSize As Integer) As Long


Const SOMAXCONN As Integer = 5
'listen(API)
Private Declare PtrSafe Function listen Lib "ws2_32.dll" (ByVal s As Long, ByVal backlog As Long) As Long
'send(API)
'Private Declare PtrSafe Function send Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As String, ByVal length As Long, ByVal flags As Long, ByRef remoteAddr As sockaddr_in, ByVal remoteAddrSize As Long) As Long
Private Declare PtrSafe Function send Lib "ws2_32.dll" (ByVal s As Long, ByVal buf As String, ByVal length As Long, ByVal flags As Long) As Long

'recv(API)
Private Declare PtrSafe Function recv Lib "wsock32.dll" (ByVal socket As Long, ByVal buf As String, ByVal length As Long, ByVal flags As Long) As Long

'connect(API)
Private Declare PtrSafe Function connect Lib "ws2_32.dll" (ByVal s As Long, ByRef name As sockaddr_in, ByVal namelen As Long) As Long

'* ---  Sleep --- */
Private Declare PtrSafe Sub Sleep Lib "kernel32" (ByVal dwMilliseconds As Long)

'==================================================================================================
' Variables
'==================================================================================================
Dim ClientSocketHandle As Long
Const RecvBuffSize As Long = 2048
Dim recvBuffer As String * RecvBuffSize
Dim strbuffer As String
Dim RetCode As Long
Dim WSADATA As WSADATA
Dim DstAddr As sockaddr_in
Dim FlagTcpConnected As Integer


Public Function GetFormatMessageString(Optional ByVal dwMessageId As Long = 0) As String
    Dim dwFlags As Long
    Dim lpBuffer As String
    Dim result As Long
    
    If dwMessageId = 0 Then
        dwMessageId = VBA.Information.Err().LastDllError
    End If
    
    dwFlags = FORMAT_MESSAGE_FROM_SYSTEM Or FORMAT_MESSAGE_IGNORE_INSERTS Or FORMAT_MESSAGE_MAX_WIDTH_MASK
    lpBuffer = String(1024, vbNullChar)
    result = FormatMessage(dwFlags, 0&, dwMessageId, 0&, lpBuffer, Len(lpBuffer), 0&)
    If (result > 0) Then
        lpBuffer = Left(lpBuffer, InStr(lpBuffer, vbNullChar) - 1)
    Else
        lpBuffer = ""
    End If
    
    GetFormatMessageString = lpBuffer & "(" & dwMessageId & ")"
End Function

Public Function MAKEWORD(Lo As Byte, Hi As Byte) As Integer
    MAKEWORD = Lo + Hi * 256& Or 32768 * (Hi > 127)
End Function

Public Function TCP_Connect(ByRef IP As String)

    Dim ServerIP As String: ServerIP = IP
    Dim ServerPort As Long: ServerPort = 6000

    RetCode = WSAStartup(MAKEWORD(2, 2), WSADATA)
    If RetCode <> 0 Then
        MsgBox "WSAStartup failed with errorF" & GetFormatMessageString(RetCode)
        Exit Function
    End If

    'TCP socket
    ClientSocketHandle = socket(AF.AF_INET, SOCKTYPE.SOCK_STREAM, 0)
    If ClientSocketHandle = INVALID_SOCKET Then
        MsgBox "SOCKET failed with errorF" & GetFormatMessageString(Err.LastDllError)
        GoTo EXIT_POINT
    End If

    DstAddr.sin_family = AF.AF_INET
    DstAddr.sin_addr = inet_addr(ServerIP)
    DstAddr.sin_port = htons(Convert_u_short_PortNumber(ServerPort))

    'TCP connect
    RetCode = connect(ClientSocketHandle, DstAddr, LenB(DstAddr))
    If RetCode = INVALID_SOCKET Then
        MsgBox "w_connect failed with errorF" & GetFormatMessageString(Err.LastDllError)
        GoTo EXIT_POINT
    End If
    
    FlagTcpConnected = 1
    
    Exit Function

EXIT_POINT:
    FlagTcpConnected = 0
    
    closesocket (ClientSocketHandle)
    ClientSocketHandle = 0
    WSACleanup
    
End Function

Public Function TCP_Disconnect()
    FlagTcpConnected = 0
    
    closesocket (ClientSocketHandle)
    ClientSocketHandle = 0
    WSACleanup
End Function

Public Function TCPSend(ByRef Msg As String)

    RetCode = send(ClientSocketHandle, Msg, Len(Msg), 0)
    
    If RetCode = SOCKET_ERROR Then
        GoTo EXIT_POINT
    End If
    
    FlagTcpConnected = 1
    
    Exit Function
    
EXIT_POINT:
    closesocket (ClientSocketHandle)
    ClientSocketHandle = 0
    WSACleanup
    
    FlagTcpConnected = 0
    
End Function

Public Function TCPRecv()

    'Malloc Memory for RX
    recvBuffer = String(RecvBuffSize, vbNullChar)

    RetCode = recv(ClientSocketHandle, recvBuffer, RecvBuffSize, 0)
    If (RetCode > 0) Then
        TCPRecv = recvBuffer
    Else
        GoTo EXIT_POINT
    End If
    
    FlagTcpConnected = 1
    
    Exit Function
        
EXIT_POINT:
    closesocket (ClientSocketHandle)
    ClientSocketHandle = 0
    WSACleanup
    
    FlagTcpConnected = 0
    
End Function

Public Function TCPStatus()
    TCPStatus = FlagTcpConnected
End Function

Function u_short_PortNumberToLong(ByVal u_short_PortNumber As Integer) As Long
    u_short_PortNumberToLong = 65535 And u_short_PortNumber
End Function

Function Convert_u_short_PortNumber(ByVal PortNumber As Long) As Integer
    Select Case PortNumber
        Case Is < 0&: Err.Raise "UnderFlow  PortNumber is 0 - 65535"
        Case 0 To 32767:  Convert_u_short_PortNumber = PortNumber
        Case 32768 To 65535: Convert_u_short_PortNumber = PortNumber - 65536
        Case Is > 65535: Err.Raise Number:=513, Description:="OverFlow PortNumber is 0 - 65535"
    End Select
End Function

